home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue34 / construc / BERT.DPR next >
Encoding:
Text File  |  1998-05-12  |  3.5 KB  |  133 lines
  1. library BERT;
  2. {.$DEFINE DEBUG}
  3. uses
  4.   Windows, SysUtils, ISAPI, IniFiles, DB, DBTables;
  5.  
  6.   function GetExtensionVersion(var Ver: THSE_VERSION_INFO): BOOL; stdcall;
  7.   begin
  8.     Ver.dwExtensionVersion := $00010000;  // 1.0 support
  9.     Ver.lpszExtensionDesc := 'Delphi 3.0 ISAPI DLL'; // Description
  10.     Result := True;
  11.   end {GetExtensionVersion};
  12.  
  13.   function HttpExtensionProc(var ECB: TEXTENSION_CONTROL_BLOCK): DWORD; stdcall;
  14.   var
  15.     Data: AnsiString;
  16.  
  17.     function Value(const Field: ShortString): ShortString;
  18.     var
  19.       i: Integer;
  20.       len: Byte absolute Result;
  21.     begin
  22.       Len := 0;
  23.       i := Pos('&'+Field+'=',Data);
  24.       if i = 0 then
  25.       begin
  26.         i := Pos(Field+'=',Data);
  27.         if i > 1 then i := 0
  28.       end
  29.       else Inc(i); { skip '&' }
  30.       if i > 0 then
  31.       begin
  32.         Inc(i,Length(Field)+1);
  33.         while Data[i] <> '&' do
  34.         begin
  35.           if not (Data[i] in [#10,#13]) then { ignore CR/LF }
  36.           begin
  37.             Inc(Len);
  38.             Result[Len] := Data[i]
  39.           end
  40.           else { CR/LF -> #32 }
  41.           begin
  42.             if (Len = 0) or (Result[Len] <> #32) then
  43.             begin
  44.               Inc(Len);
  45.               Result[Len] := #32
  46.             end
  47.           end;
  48.           Inc(i)
  49.         end
  50.       end;
  51.       while (Len > 0) and (Result[len] = #32) do Dec(len)
  52.     end {Value};
  53.  
  54.     function ValueAsInteger(const Field: ShortString): Integer;
  55.     begin
  56.       try
  57.         Result := StrToInt(Value(Field))
  58.       except
  59.         Result := 0
  60.       end
  61.     end {ValueAsInteger};
  62.  
  63. {$I BERT.INC}
  64.  
  65.   var
  66.     i: Integer;
  67.     Str: AnsiString;
  68.   begin
  69.     Str := 'Hello, world!';
  70.     try
  71.       try
  72.       // parse ECB input data
  73.         if StrPas(ECB.lpszMethod) = 'POST' then
  74.           Data := StrPas(ECB.lpbData)
  75.         else Data := ECB.lpszQueryString;
  76.         if (Length(Data) > 1)  and
  77.            (Data[Length(Data)] = #0) then Delete(Data,Length(Data),1);
  78.         i := 0;
  79.         while i < Length(Data) do
  80.         begin
  81.           Inc(i);
  82.           if Data[i] = '+' then Data[i] := ' ';
  83.           if Data[i] = '%' then { special code }
  84.           begin
  85.             Str := '$00';
  86.             Str[2] := Data[i+1];
  87.             Str[3] := Data[i+2];
  88.             Delete(Data,i+1,2);
  89.             Data[i] := Chr(StrToInt(Str))
  90.           end
  91.         end;
  92.         if i > 0 then Data[i+1] := '&'
  93.                  else Data := '&';
  94.       // initialize ECB output data
  95.         ECB.lpszLogData := 'BERT - Bolesian Error Report Tool';
  96.         ECB.dwHTTPStatusCode := 200;
  97.  
  98.       // create the dynamic HTML webpage here inside STR...
  99.         try
  100.           GenerateContents(Str);
  101.           Str := '[' + Data + ']<P>' + Str
  102.         except
  103.           on E: Exception do
  104.             Str := Str + '<P>IN<P><HR><P>' + E.ClassName + ' ' + E.Message
  105.         end;
  106.       except
  107.         on E: Exception do
  108.           Str := Str + '<P>OUT<P><HR><P>' + E.ClassName + ' ' + E.Message
  109.       end;
  110.     finally
  111.     // finalize ECB output data
  112.       Str := Format(
  113.         'HTTP/1.0 200 OK'#13#10+
  114.         'Content-Type: text/html'#13#10+
  115.         'Content-Length: %d'#13#10+
  116.         'Content:'#13#10#13#10'%s', [Length(Str), Str]);
  117.       i := Length(Str);
  118.       ECB.WriteClient(ECB.ConnID, Pointer(Str), i, 0)
  119.     end;
  120.     Result := HSE_STATUS_SUCCESS
  121.   end {HttpExtensionProc};
  122.  
  123. exports
  124.   GetExtensionVersion,
  125.   HttpExtensionProc;
  126.  
  127. begin
  128.   IsMultiThread := True;
  129.   ChDir('D:');
  130.   ChDir('cgi_bin');
  131.   if IOResult <> 0 then { skip }
  132. end.
  133.